


##ITEM CODES AND DESCRIPTIONS
pi.names <- rbind(c('CC317','Presidential Vote (Obama/McCain)'),
                  c('CC354c','Presidential Vote (Obama/Romney)'),
                  c('presvote','Presidential Vote 2012'),
                  c('housevote','House Vote 2012'),
                  c('CC320','Gun Control'),
                  c('CC332A','Ryan Budget Bill'),
                  c('CC332B','Simpson-Bowles Budget Plan'),
                  c('CC332C','Middle Class Tax Cut Act'),
                  c('CC332D','Tax Hike Prevention Act'),
                  c('CC332E','Birth Control Exemption'),
                  c('CC332F','U.S.-Korea Free Trade Agreement'),
                  c('CC332G','Repeal Affordable Care Act'),
                  c('CC332H','Keystone Pipeline'),
                  c('CC332I','Affordable Care Act of 2010'),
                  c('CC332J','End DADT'),
                  c('CC326','Support Same-Sex Marriage'),
                  c('CC322_1','Immig: Grant Legal Status'),
                  c('CC322_2','Immig: Incr. Border Patrol'),
                  c('CC322_3','Immig: Police Questioning'),
                  c('CC322_4','Immig: Fine US businesses'),
                  c('CC322_5','Immig: Prohibit Services'),
                  c('CC322_6','Immig: Automatic Citizenship'),
                  c('CC321','Take Action on Climate Change'),
                  c('CC327','Affirmative Action'),
                  c('CC324','Abortion'),
                  c('CC324a','Abortion: Never'),
                  c('CC324b','Abortion: Some Conditions'),
                  c('CC324c','Abortion: Always'),
                  c('CC305','Iraq War Mistake'),
                  c('CC306','Afganistan War Mistake'),
                  c('CC328','Balanced Budget Pref.'),
                  c('CC329','Fiscal Pref.'),
                  c('CC325','Environment/Economy'),
                  c('CC415r','Taxes vs. Spending'),
                  c('CC416r','Income vs. Sales Tax'),
                  c('CC414_6','Military Troops to Support U.N.'),
                  c('CC413c','Vote for State Senate'),
                  c('CC328b','Budget Pref. 2'),
                  c('CC329c','Budget Pref. 2'),
                  c('CC422a','Racial Resentment 1'),
                  c('CC422b','Racial Resentment 2'),
                  c('CC302b','Responsibility for Economy')
                  )

optclass <- function(cp,vote,ips){
    sumerr1 <- sum(ifelse((vote == 1 & ips>=cp) | (vote == 0 & ips<cp),1,0))
    sumerr2 <- sum(ifelse((vote == 1 & ips<=cp) | (vote == 0 & ips>cp),1,0))
    maxerr <- max(sumerr1,sumerr2)
    return(c(cp,maxerr))
}

class.fun <- function(m1.in,quse=NA,optclass=TRUE){

    y <- (as.numeric(m1.in$y))
    prob=predict(m1.in,type=c("response"))
    g <- roc(y ~ prob)

    y <- (as.numeric(m1.in$y))
    if(ncol(m1$model)==2 & optclass){
        x <- m1$model[,'xx']
        x1 <- unique(x[order(x)])
        x1 <- unique(c(min(x1)-.01,x1+c(diff(x1)/2,.01),max(x1)+.01))
        oo <- t(sapply(x1,function(z){optclass(z,ips=x,vote=y)}))
        oc <- oo[which.max(oo[,2]) ,2]/length(y)
        optclass.corrvotes <- oo[which.max(oo[,2]) ,2]
        uu <- uu & !is.na(xx)
    }else{
        oc <- NA
        optclass.corrvotes <- NA
    }
    tt <- table(m1.in$y,as.numeric(m1.in$fitted.values>=.5))
    mincc <- 1-(min(table(m1.in$y))/sum(table(m1.in$y)))
    corrvotes <-   sum(m1.in$y == (m1.in$fitted.values >= .5))
    cf$donated_ns2 <- (cf$binned_2010numR + cf$binned_2012numR)
 
    
    if(sum(!is.na(quse))==0){
        quse <- cf$donated_ns[uu]>0
        quse <- (cf$binned_2010numR[uu] > 0 & cf$binned_2012numR[uu]>0)
    }
    if(length(quse) > length(m1.in$y)){
        quse <- quse[uu]
    }
    corrvotes.sr <-   sum(m1.in$y[quse] == (m1.in$fitted.values[quse] >= .5))
    corrvotes.nsr <-   sum(m1.in$y[!quse] == (m1.in$fitted.values[!quse] >= .5))

    if(length(m1$y) != length(cf$donated_ns2[uu])){
        tt2 <- t(table(m1$y==as.numeric(m1$fitted.values>=.5),cf$donated_ns2[uu & !is.na(xx)]>0))
    }else{
        tt2 <- t(table(m1$y==as.numeric(m1$fitted.values>=.5),cf$donated_ns2[uu]>0))
    }
    selfreport=round(tt2[,2]/rowSums(tt2),3)

    if(length(m1$y) != length(cf$donated_ns2[uu])){
           ddns <- ifelse(cf$donated_ns2[uu & !is.na(xx)]==1,0,
                ifelse(cf$donated_ns2[uu & !is.na(xx)]==2,1,
                ifelse(cf$donated_ns2[uu & !is.na(xx)]>2,3,
                ifelse(cf$donated_ns2[uu & !is.na(xx)]==3,3,4))))
    }else{
        ddns <- ifelse(cf$donated_ns2[uu]==1,0,
                ifelse(cf$donated_ns2[uu]==2,1,
                ifelse(cf$donated_ns2[uu]>2,3,
                ifelse(cf$donated_ns2[uu]==3,3,4))))
    }



    tt2 <- t(table(m1$y==as.numeric(m1$fitted.values>=.5),ddns))
    selfreport.all=round(tt2/rowSums(tt2),3)[,2]
    if(corrvotes < max(table(m1.in$y))){corrvotes=max(table(m1.in$y))}
    if(corrvotes.sr < max(table(m1.in$y[quse]))){corrvotes.sr=max(table(m1.in$y[quse]))}
    if(corrvotes.nsr < max(table(m1.in$y[!quse]))){corrvotes.nsr=max(table(m1.in$y[!quse]))}
    cc.in <- sum(corrvotes)/length(m1.in$y)

    oo <- data.frame(i,
                     loglik=logLik(m1.in)[[1]],
                     tvotes=length(m1.in$y),
                     maxvotes=max(table(m1.in$y)),
                     corrvotes=corrvotes,
                     min.cc=mincc,
                     cc=cc.in,
                     optclass.cc=oc,
                     apre=1-((1-cc.in)/(1-mincc)),
                     optclass.corrvotes=optclass.corrvotes,
                     optclass.apre=1-((1-(oc))/(1-mincc)),
                     auc=g$auc,
                     selfreport=selfreport[2],
                     not.selfreport=selfreport[1],
                     corrvotes.sr=corrvotes.sr,
                     cc.sr=sum(corrvotes.sr)/length(m1.in$y[quse]),
                     tvotes.sr=length(m1.in$y[quse]),
                     cc.nsr=sum(corrvotes.nsr)/length(m1.in$y[!quse]),
                     corrvotes.nsr=corrvotes.nsr,
                     tvotes.nsr=length(m1.in$y[!quse])
 
                     ## selfreport.all[1],
                     ## selfreport.all[2],
                     ## selfreport.all[3],
                     ## selfreport.all[4]
                     
                     ##cc.rf=cc.rf,
                     ##apre.rf=1-((1-cc.rf)/1-mincc)
                     )
    return(oo)
}



panel.cor <- function(x, y,col=col, digits = 3, prefix = "r = ", cex.cor, ...){
    prefix <- ''
    usr <- par("usr"); on.exit(par(usr))
    par(usr = c(0, 1, 0, 1))
    r <- round(abs(cor(x, y,use='complete.obs')),3)
    txt <- format(c(r, 0.123456789), digits = digits)[1]
    txt <-    paste0('All: ',prefix, txt)
    rdem <- round(abs(cor(x[col %in% c('blue','black')], y[col %in% c('blue','black')],use='complete.obs')),3)
    txtdem <- format(c(rdem, 0.123456789), digits = digits)[1]
    txtdem <- paste0('Dem: ',prefix, txtdem)
    rind <- round(abs(cor(x[col %in% c('orange','grey')], y[col %in% c('orange','grey')],use='complete.obs')),3)
    txtind <- format(c(rind, 0.123456789), digits = digits)[1]
    txtind <- paste0('Ind: ',prefix, txtind)
    rrep <- round(abs(cor(x[col %in% c('red','darkgrey')], y[col %in% c('red','darkgrey')],use='complete.obs')),3)
    txtrep <- format(c(rrep, 0.123456789), digits = digits)[1]
    txtrep <- paste0('Rep: ',prefix, txtrep)
    if(missing(cex.cor)) cex.cor <- 0.8/strwidth(txt)
    ##text(0.5, 0.45, txt, cex = 1.35)
    text(0.5, 0.7, txt, cex = 1.35,family = "mono")
    text(0.5, 0.55, txtdem, cex = 1.35 ,col='blue',family = "mono")
    text(0.5, 0.40, txtind, cex = 1.35 ,col='orange',family = "mono")
    text(0.5, 0.25, txtrep, cex = 1.35 ,col='red',family = "mono")
}

panel.hist <- function(x,...) {
    usr <- par("usr")
    par(new = TRUE,c(usr[1:2], 0, 1.5))
    pcol1 <- pcol[uu]
    cuse <- complete.cases(cbind(x,pcol1))
    x1 <- x[cuse]
    col1 <- pcol1[cuse]
    yul <- max(max(density(x1[col1 %in% c('red','blue')],bw = "SJ",adjust=2)$y),
               max(density(x1[col1 %in% c('red','blue')],bw = "SJ",adjust=2)$y))
    pc <- factor(col1)
    if(length(unique(x)) < 25){
        boxplot(x1~pc)
    }else{
        densityPlot(x1~pc,
                    adjust=1,
                    rug=FALSE,
                    grid=FALSE,
                    lty=rep(1,length(unique(pc))),
                    legend.location = NA,
                    ylim=c(0,yul*1.5),
                    xaxt='n',yaxt='n',
                    col=c('blue','red'))
    }
}

points2 <- function(x,y,col=col,jit=FALSE,grayscale=FALSE,...){
    if(jit){
        if(length(unique(x)) < 25){
            x <- jitter(x,.75)
        }
        if(length(unique(y)) < 25){
            y <- jitter(y,.75)
        }
    }else{browser()}
    if(grayscale){
        col[col=='red'] <- 'black'
        col[col=='blue'] <- 'grey'
        col[col=='orange'] <- 'darkgrey'
    }
    points(x,y,col=col,alpha=.25,pch=20,cex=.25)
}
